Análise venda de imóveis

Resumo

Este projeto fará uma análise exploratória dos dados de um dataset de venda de casas, para realizar a predição de preços de novas casas com caracteristicas semelhantes as ja vendidas

Visão geral do dataset

Verificando quantidade de registros e de colunas respectivamente do conjunto de dados

df %>% str %>% knitr::kable()
## spec_tbl_df[,7] [5,000 × 7] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
##  $ media de lucro de venda: num [1:5000] 79545 79249 61287 63345 59982 ...
##  $ media idade das casas  : num [1:5000] 5.68 6 5.87 7.19 5.04 ...
##  $ media numero de salas  : num [1:5000] 7.01 6.73 8.51 5.59 7.84 ...
##  $ media numero de quartos: num [1:5000] 4.09 3.09 5.13 3.26 4.23 4.04 3.41 2.42 2.3 6.1 ...
##  $ populacao da regiao    : num [1:5000] 23087 40173 36882 34310 26354 ...
##  $ valor da casa          : num [1:5000] 1059034 1505891 1058988 1260617 630943 ...
##  $ endereco               : chr [1:5000] "208 Michael Ferry Apt. 674\nLaurabury, NE 37010-5101" "188 Johnson Views Suite 079\nLake Kathleen, CA 48958" "9127 Elizabeth Stravenue\nDanieltown, WI 06482-3489" "USS Barnett\nFPO AP 44820" ...
##  - attr(*, "spec")=
##   .. cols(
##   ..   `Avg. Area Income` = col_double(),
##   ..   `Avg. Area House Age` = col_double(),
##   ..   `Avg. Area Number of Rooms` = col_double(),
##   ..   `Avg. Area Number of Bedrooms` = col_double(),
##   ..   `Area Population` = col_double(),
##   ..   Price = col_double(),
##   ..   Address = col_character()
##   .. )

|| || || ||

df %>% head(4) %>% knitr::kable()
media de lucro de venda media idade das casas media numero de salas media numero de quartos populacao da regiao valor da casa endereco
79545.46 5.682861 7.009188 4.09 23086.80 1059034 208 Michael Ferry Apt. 674
Laurabury, NE 37010-5101
79248.64 6.002900 6.730821 3.09 40173.07 1505891 188 Johnson Views Suite 079
Lake Kathleen, CA 48958
61287.07 5.865890 8.512727 5.13 36882.16 1058988 9127 Elizabeth Stravenue
Danieltown, WI 06482-3489
63345.24 7.188236 5.586729 3.26 34310.24 1260617 USS Barnett
FPO AP 44820

Visualizando a distribuição de preços das casas por quantidade de quartos

ggplot(df, aes(x=df$`media numero de quartos`, y=df$`valor da casa`)) + geom_point(color="cyan4") + theme_calc() +
  
labs(x="Numero de quartos",y="Valor da casa", parse = F, colour = "black", size = 12,family="Times New Roman") +
theme(text=element_text(size=14, family="Times New Roman", colour="black"), axis.text=element_text(family="Times New Roman", size=14,colour="black"))

OBS: Não há grande variação de preço por numero de quartos, mas da pra perceber que casas que contém em media 2 quartos, são um pouco mais baratas em seu valor máximo


Visualizando a distribuição de preços das casas por quantidade de salas

ggplot(df, aes(x = df$`media numero de salas`, y=df$`valor da casa`)) + geom_point(color="dodgerblue3") + theme_gdocs() +
scale_x_continuous(breaks = seq(3, 11, by=1)) +
  
labs(x="Numero de salas",y="Valor da casa", parse = F, colour = "black", size = 12,family="Times New Roman") +
theme(text=element_text(size=14, family="Times New Roman", colour="black"), axis.text=element_text(family="Times New Roman", size=14,colour="black"))

OBS: obviamente, quanto maior a quantidade de salas, maior o preço da casa, em alguns poucos casos, casas com numero menor de salas sao mais caras

OBS 2: Também é possivel notar que a grande maioria das casas possuem entre 6 a 8 salas


Visualizando a distribuição de salas por quantidade de quartos

ggplot(df, aes(x=df$`media numero de quartos`, y=df$`media numero de salas`)) + geom_point(color="hotpink4") + theme_gdocs() +

labs(x="Numero de quartos",y="Numero de salas", parse = F, colour = "black", size = 12,family="Times New Roman") +
theme(text=element_text(size=14, family="Times New Roman", colour="black"), axis.text=element_text(family="Times New Roman", size=14,colour="black"))

OBS: Podemos ver que todas as casas com 5 quartos ou mais, possuem no mínimo 7 salas

OBS 2: Também observamos que casas com 2 quartos, possuem no maximo 7 salas


Visualizando distribuição do preço da casa baseado pela idade da mesma

ggplot(df, aes(x=df$`media idade das casas`, y=df$`valor da casa`)) + geom_point(color="magenta4") + theme_gdocs() +
scale_x_continuous(breaks = seq(0,10,1)) +
labs(x="Idade do imóvel",y="Valor", parse = F, colour = "black", size = 12,family="Times New Roman") +
theme(text=element_text(size=14, family="Times New Roman", colour="black"), axis.text=element_text(family="Times New Roman", size=14,colour="black"))

OBS: E mais uma amostra linear onde indica que, quanto mais velha a casa, maior o seu valor


Visualizando distribuição de preços da casa por tamanho da população da região

ggplot(df, aes(y=df$`valor da casa`, x=df$`populacao da regiao`)) + geom_point(color="dodgerblue3") + theme_gdocs() +
labs(x="População da região",y="Valor do imóvel", parse = F, colour = "black", size = 12,family="Times New Roman") +
theme(text=element_text(size=14, family="Times New Roman", colour="black"), axis.text=element_text(family="Times New Roman", size=14,colour="black"))

OBS: Quanto maior a população da região, maior o valor do imóvel


Visualizando correlações entre as variáveis

ggcorr(df, label = T, hjust = 0.85)
## Warning in ggcorr(df, label = T, hjust = 0.85): data in column(s) 'endereco' are
## not numeric and were ignored

OBS: As maiores correlações com a variavel “valor da casa” sao: populacao da regiao, idade da casa, lucro de venda e numero de salas


Machine Learning

Filtrando variáveis significantes para o modelo

Três modelos serão criados, o modelo1 com as variaveis lucro de venda e idade das casas.

O modelo2 com as variaveis lucro de venda, idade das casas e populacao da regiao.

O modelo3 com as variaveis lucro de venda, idade das casas, populacao da regiao e numero de salas.

modelo1 <- lm(`valor da casa` ~ -1 + `media de lucro de venda` + `media idade das casas`, data = df)
modelo2 <- lm(`valor da casa` ~ -1 + `media de lucro de venda` + `media idade das casas` + `populacao da regiao`, data = df)
modelo3 <- lm(`valor da casa` ~ -1 + `media de lucro de venda` + `media idade das casas` + `populacao da regiao` + `media numero de salas`, data = df)

Avaliando desempenho de cada modelo

Modelo1

modelo1 %>% summary
## 
## Call:
## lm(formula = `valor da casa` ~ -1 + `media de lucro de venda` + 
##     `media idade das casas`, data = df)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -959963 -188108  -13771  157647  881064 
## 
## Coefficients:
##                             Estimate Std. Error t value            Pr(>|t|)    
## `media de lucro de venda`    12.1051     0.2344   51.64 <0.0000000000000002 ***
## `media idade das casas`   69755.4803  2685.2904   25.98 <0.0000000000000002 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 256800 on 4998 degrees of freedom
## Multiple R-squared:  0.9599, Adjusted R-squared:  0.9599 
## F-statistic: 5.979e+04 on 2 and 4998 DF,  p-value: < 0.00000000000000022

OBS 1: Quase 96% dos dados do valor da casa, podem ser explicados pelas variáveis preditoras escolhidas

OBS 2: Também e perceptivel que a margem de erros das duas variáveis são proximas a zero


Modelo2

modelo2 %>% summary
## 
## Call:
## lm(formula = `valor da casa` ~ -1 + `media de lucro de venda` + 
##     `media idade das casas` + `populacao da regiao`, data = df)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -860295 -181826  -16066  147448  908911 
## 
## Coefficients:
##                             Estimate Std. Error t value            Pr(>|t|)    
## `media de lucro de venda`     9.9145     0.2382   41.63 <0.0000000000000002 ***
## `media idade das casas`   47965.8638  2681.6574   17.89 <0.0000000000000002 ***
## `populacao da regiao`         7.8613     0.3167   24.82 <0.0000000000000002 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 242300 on 4997 degrees of freedom
## Multiple R-squared:  0.9643, Adjusted R-squared:  0.9643 
## F-statistic: 4.497e+04 on 3 and 4997 DF,  p-value: < 0.00000000000000022

OBS 1: 96,43% dos dados do valor da casa, podem ser explicados pelas variáveis preditoras escolhidas

OBS 2: Também e perceptivel que a margem de erros das três variáveis são proximas a zero


Modelo3

modelo3 %>% summary
## 
## Call:
## lm(formula = `valor da casa` ~ -1 + `media de lucro de venda` + 
##     `media idade das casas` + `populacao da regiao` + `media numero de salas`, 
##     data = df)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -870342 -182077  -15701  148139  916097 
## 
## Coefficients:
##                             Estimate Std. Error t value             Pr(>|t|)
## `media de lucro de venda`    10.2460     0.2686  38.149 < 0.0000000000000002
## `media idade das casas`   51319.5652  2961.0686  17.331 < 0.0000000000000002
## `populacao da regiao`         8.0786     0.3269  24.715 < 0.0000000000000002
## `media numero de salas`   -7326.3875  2750.6482  -2.664              0.00776
##                              
## `media de lucro de venda` ***
## `media idade das casas`   ***
## `populacao da regiao`     ***
## `media numero de salas`   ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 242100 on 4996 degrees of freedom
## Multiple R-squared:  0.9643, Adjusted R-squared:  0.9643 
## F-statistic: 3.377e+04 on 4 and 4996 DF,  p-value: < 0.00000000000000022

OBS 1: Não há diferença se comparado ao modelo dois no que diz respeito a explicação dos dados

OBS 2: É notavel que a variavel “numero de salas” tem uma margem de erro consideravelmente maior que as outras 3 variaveis


Visualizando o desempenho das predições dos 3 modelos

Será comparado os resultados estimados com os resultados originais em um gráfico de dispersão.

Predições do modelo 1

pred1 <- tibble(dadosReais=df$`valor da casa`, predicoes=modelo1$fitted.values, residuosPadronizados=rstandard(modelo1))

ggplot(pred1, aes(x=dadosReais, y=predicoes)) + geom_point(color="seagreen4") + theme_gdocs()

OBS: Criado com as variáveis valor da casa, media de lucro de venda e media idade das casas


Predições do modelo 2

pred2 <- tibble(N=1:5000, dadosReais=df$`valor da casa`, predicoes=modelo2$fitted.values, residuos=modelo2$residuals, residuosPadronizados=rstandard(modelo2))

ggplot(pred2, aes(x=dadosReais, y=predicoes)) + geom_point(color="seagreen4") + theme_gdocs()

OBS: Criado com as variáveis valor da casa e media de lucro de venda


Predições do modelo 3

pred3 <- tibble(dadosReais=df$`valor da casa`, predicoes=modelo3$fitted.values, residuosPadronizados=rstandard(modelo3))

ggplot(pred3, aes(x=dadosReais, y=predicoes)) + geom_point(color="seagreen4") + theme_gdocs()

OBS: Criado com as variáveis valor da casa, media de lucro de venda, media idade das casas, populacao da regiao, media numero de salas


Observações sobre as predições

Claramente o modelo2 teve um desempenho melhor, justamente por possuir as duas variáveis de maior correlação com a variável valor da casa


Verificando possiveis outliers do melhor modelo

Foi filtrado todos os residuos padronizados com valor maior ou igual a 1.96, ou, menor ou igual -1.96

pred2 %>% filter(residuosPadronizados >= 1.96 | residuosPadronizados <= -1.96) %>% nrow()
## [1] 241

OBS: Dos 5 mil registros, 241 são outliers


Comparando desempenho do modelo2 com e sem outliers

Armazenando a identificação dos outliers identificados dentro de uma variavel vetor, e usando esta variavel para remover os outliers do modelo.

outliers <- pred2 %>% filter(residuosPadronizados >= 1.96 | residuosPadronizados <= -1.96) %>% select(N)
outliers <- outliers$N

reaisSemOutliers <- df$`valor da casa`[-outliers]
predSemOutliers <- modelo2$fitted.values[-outliers]
semOutliers <- tibble(dadosReais=reaisSemOutliers, predicoes=predSemOutliers)

modelo2SemOut <- ggplot(semOutliers, aes(x=dadosReais, y=predicoes)) + geom_point(color="deeppink4") + theme_gdocs()

modelo2ComOut <- ggplot(pred2, aes(x=dadosReais, y=predicoes)) + geom_point(color="deeppink4") + theme_gdocs()

Visualizando o desempenho do modelo2 com e sem outliers

Modelo2 COM outliers

modelo2ComOut + guides(size = FALSE) + theme(plot.margin = margin(1,.8,2,.8, "cm"))

OBS: Extremidades mais dispersas.


Modelo2 SEM outliers

modelo2SemOut +  guides(size = FALSE) + theme(plot.margin = margin(2.5,.8,2,.8, "cm"))

OBS: Extremidades mais concentradas